home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / pastutor.EXE / tutor04a.pas < prev    next >
Pascal/Delphi Source File  |  1998-04-02  |  4KB  |  137 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision 2.0 Demo                        }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program Tutor04a;
  9.  
  10. uses TutConst, Drivers, Objects, Views, Menus, App, MsgBox;
  11.  
  12. type
  13.   TTutorApp = object(TApplication)
  14.     constructor Init;
  15.     procedure DoAboutBox;
  16.     procedure HandleEvent(var Event: TEvent); virtual;
  17.     procedure InitMenuBar; virtual;
  18.     procedure InitStatusLine; virtual;
  19.     procedure NewWindow;
  20.   end;
  21.  
  22. constructor TTutorApp.Init;
  23. begin
  24.   inherited Init;
  25.   DisableCommands([cmOrderWin, cmStockWin, cmSupplierWin]);
  26. end;
  27.  
  28. procedure TTutorApp.DoAboutBox;
  29. begin
  30.   MessageBox(#3'Turbo Vision Tutorial Application'#13 +
  31.     #3'Copyright 1992'#13#3'Borland International',
  32.     nil, mfInformation or mfOKButton);
  33. end;
  34.  
  35. procedure TTutorApp.HandleEvent(var Event: TEvent);
  36. var
  37.   R: TRect;
  38. begin
  39.   inherited HandleEvent(Event);
  40.   if Event.What = evCommand then
  41.   begin
  42.     case Event.Command of
  43.       cmNew:
  44.         begin
  45.           NewWindow;
  46.           ClearEvent(Event);
  47.         end;
  48.       cmOptionsVideo:
  49.         begin
  50.           SetScreenMode(ScreenMode xor smFont8x8);
  51.           ClearEvent(Event);
  52.         end;
  53.       cmAbout:
  54.         begin
  55.           DoAboutBox;
  56.           ClearEvent(Event);
  57.         end;
  58.     end;
  59.   end;
  60. end;
  61.  
  62. procedure TTutorApp.InitMenuBar;
  63. var
  64.   R: TRect;
  65. begin
  66.   GetExtent(R);
  67.   R.B.Y := R.A.Y + 1;
  68.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  69.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  70.       StdFileMenuItems(nil)),
  71.     NewSubMenu('~E~dit', hcNoContext, NewMenu(
  72.       StdEditMenuItems(
  73.       NewLine(
  74.       NewItem('~S~how clipboard', '', kbNoKey, cmClipShow, hcNoContext,
  75.       nil)))),
  76.     NewSubMenu('~O~rders', hcNoContext, NewMenu(
  77.       NewItem('~N~ew', 'F9', kbF9, cmOrderNew, hcNoContext,
  78.       NewItem('~S~ave', '', kbNoKey, cmOrderSave, hcNoContext,
  79.       NewLine(
  80.       NewItem('Next', 'PgDn', kbPgDn, cmOrderNext, hcNoContext,
  81.       NewItem('Prev', 'PgUp', kbPgUp, cmOrderPrev, hcNoContext,
  82.       nil)))))),
  83.     NewSubMenu('O~p~tions', hcNoContext, NewMenu(
  84.       NewItem('~T~oggle video', '', kbNoKey, cmOptionsVideo, hcNoContext,
  85.       NewItem('~S~ave desktop', '', kbNoKey, cmOptionsSave, hcNoContext,
  86.       NewItem('~L~oad desktop', '', kbNoKey, cmOptionsLoad, hcNoContext,
  87.       nil)))),
  88.     NewSubMenu('~W~indow', hcNoContext, NewMenu(
  89.       NewItem('Orders', '', kbNoKey, cmOrderWin, hcNoContext,
  90.       NewItem('Stock items', '', kbNoKey, cmStockWin, hcNoContext,
  91.       NewItem('Suppliers', '', kbNoKey, cmSupplierWin, hcNoContext,
  92.       NewLine(
  93.       StdWindowMenuItems(nil)))))),
  94.     NewSubMenu('~H~elp', hcNoContext, NewMenu(
  95.       NewItem('~A~bout...', '', kbNoKey, cmAbout, hcNoContext,
  96.       nil)),
  97.     nil))))))
  98.   )));
  99. end;
  100.  
  101. procedure TTutorApp.InitStatusLine;
  102. var
  103.   R: TRect;
  104. begin
  105.   GetExtent(R);
  106.   R.A.Y := R.B.Y - 1;
  107.   New(StatusLine, Init(R,
  108.     NewStatusDef(0, $EFFF,
  109.       NewStatusKey('~F3~ Open', kbF3, cmOpen,
  110.       NewStatusKey('~F4~ New', kbF4, cmNew,
  111.       NewStatusKey('~Alt+F3~ Close', kbAltF3, cmClose,
  112.       StdStatusKeys(nil)))),
  113.     NewStatusDef($F000, $FFFF,
  114.       NewStatusKey('~F6~ Next', kbF6, cmOrderNext,
  115.       NewStatusKey('~Shift+F6~ Prev', kbShiftF6, cmOrderPrev,
  116.       StdStatusKeys(nil))), nil))));
  117. end;
  118.  
  119. procedure TTutorApp.NewWindow;
  120. var
  121.   R: TRect;
  122.   TheWindow: PWindow;
  123. begin
  124.   R.Assign(0, 0, 60, 20);
  125.   TheWindow := New(PWindow, Init(R, 'A window', wnNoNumber));
  126.   InsertWindow(TheWindow);
  127. end;
  128.  
  129. var
  130.   TutorApp: TTutorApp;
  131.  
  132. begin
  133.   TutorApp.Init;
  134.   TutorApp.Run;
  135.   TutorApp.Done;
  136. end.
  137.